home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / library / dialog.tcl < prev    next >
Encoding:
Text File  |  1995-06-29  |  3.4 KB  |  110 lines
  1. # dialog.tcl --
  2. #
  3. # This file defines the procedure tk_dialog, which creates a dialog
  4. # box containing a bitmap, a message, and one or more buttons.
  5. #
  6. # @(#) dialog.tcl 1.15 95/06/28 17:15:54
  7. #
  8. # Copyright (c) 1992-1993 The Regents of the University of California.
  9. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #
  16. # tk_dialog:
  17. #
  18. # This procedure displays a dialog box, waits for a button in the dialog
  19. # to be invoked, then returns the index of the selected button.
  20. #
  21. # Arguments:
  22. # w -        Window to use for dialog top-level.
  23. # title -    Title to display in dialog's decorative frame.
  24. # text -    Message to display in dialog.
  25. # bitmap -    Bitmap to display in dialog (empty string means none).
  26. # default -    Index of button that is to display the default ring
  27. #        (-1 means none).
  28. # args -    One or more strings to display in buttons across the
  29. #        bottom of the dialog box.
  30.  
  31. proc tk_dialog {w title text bitmap default args} {
  32.     global tkPriv
  33.  
  34.     # 1. Create the top-level window and divide it into top
  35.     # and bottom parts.
  36.  
  37.     catch {destroy $w}
  38.     toplevel $w -class Dialog
  39.     wm title $w $title
  40.     wm iconname $w Dialog
  41.     wm protocol $w WM_DELETE_WINDOW { }
  42.     wm transient $w [winfo toplevel [winfo parent $w]]
  43.     frame $w.top -relief raised -bd 1
  44.     pack $w.top -side top -fill both
  45.     frame $w.bot -relief raised -bd 1
  46.     pack $w.bot -side bottom -fill both
  47.  
  48.     # 2. Fill the top part with bitmap and message.
  49.  
  50.     label $w.msg -wraplength 3i -justify left -text $text \
  51.         -font -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
  52.     pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
  53.     if {$bitmap != ""} {
  54.     label $w.bitmap -bitmap $bitmap
  55.     pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
  56.     }
  57.  
  58.     # 3. Create a row of buttons at the bottom of the dialog.
  59.  
  60.     set i 0
  61.     foreach but $args {
  62.     button $w.button$i -text $but -command "set tkPriv(button) $i"
  63.     if {$i == $default} {
  64.         frame $w.default -relief sunken -bd 1
  65.         raise $w.button$i $w.default
  66.         pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m
  67.         pack $w.button$i -in $w.default -padx 2m -pady 2m
  68.         bind $w <Return> "$w.button$i flash; set tkPriv(button) $i"
  69.     } else {
  70.         pack $w.button$i -in $w.bot -side left -expand 1 \
  71.             -padx 3m -pady 2m
  72.     }
  73.     incr i
  74.     }
  75.  
  76.     # 4. Withdraw the window, then update all the geometry information
  77.     # so we know how big it wants to be, then center the window in the
  78.     # display and de-iconify it.
  79.  
  80.     wm withdraw $w
  81.     update idletasks
  82.     set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  83.         - [winfo vrootx [winfo parent $w]]]
  84.     set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  85.         - [winfo vrooty [winfo parent $w]]]
  86.     wm geom $w +$x+$y
  87.     wm deiconify $w
  88.  
  89.     # 5. Set a grab and claim the focus too.
  90.  
  91.     set oldFocus [focus]
  92.     grab $w
  93.     tkwait visibility $w
  94.     if {$default >= 0} {
  95.     focus $w.button$default
  96.     } else {
  97.     focus $w
  98.     }
  99.  
  100.     # 6. Wait for the user to respond, then restore the focus and
  101.     # return the index of the selected button.  Restore the focus
  102.     # before deleting the window, since otherwise the window manager
  103.     # may take the focus away so we can't redirect it.
  104.  
  105.     tkwait variable tkPriv(button)
  106.     catch {focus $oldFocus}
  107.     destroy $w
  108.     return $tkPriv(button)
  109. }
  110.